%% ErlyDB: The Erlang Twist on Database Abstraction
%%
%% For license information see LICENSE.txt

-module(erlydb).
-export(
   [connect/5,
    connect/6,
    q/1,
    select/1,
    select/2,
    code_gen/1]).

%% Turn off warnings about metafunctions' not being used :)
-compile(nowarn_unused_function).

-define(L(Obj), io:format("LOG ~w ~p\n", [?LINE, Obj])).
-define(S(Obj), io:format("LOG ~w ~s\n", [?LINE, Obj])).

%% @doc Initialize a connection to the database.
%%
%% @spec connect(Driver::atom(), Hostname::string(), Username::string(),
%%   Password::string(), Database::string()) ->
%%     ok | {error, Error}
connect(Driver, Hostname, Username, Password, Database) ->
    connect(Driver, Hostname, Username, Password, Database, []).

%% @doc Initialize a connection (or connection pool) to the
%%   database.
%%
%% @type options() A driver-specific list of {name, Value} pairs.
%%   For more information, refer to your driver's documentation.
%%
%% @spec connect(Driver::atom(), Hostname::string(), Username::string(),
%%   Password::string(), Database::string(), Options::options()) ->
%%     ok | {error, Error}
connect(mysql, Hostname, Username, Password, Database, Options) ->
    
    %% We use Smerl to create a "virtual" database driver :)
    {ok, C1} = smerl:for_module(erlydb_mysql),
    C2 = smerl:set_module(C1, erlydb_drv),
    ok = smerl:compile(C2),

    erlydb_drv:connect(Hostname, Username, Password, Database, Options);
connect(_Driver, _Hostname, _Username, _Password, _Database, _Options) ->
    {error, dbms_not_supported}.

%% @doc Execute a query and get the raw result from the underlying driver.
%%
%% @spec q(Sql::string()) -> Result
q(Sql) ->
    erlydb_drv:q(Sql).

%% @doc Execute a select statement and return a type-converted list of rows.
%%
%% @spec select(Sql::string()) -> {ok, [Row]} | {error, Error}
select(Sql) ->
    erlydb_drv:select(Sql).

%% @doc Execute a select statement and return a type-converted list of rows.
%%   Additional per-row data is added to support higher-level ErlyDB
%%   features.
%%
%% @spec select(Sql::string(), Module::atom()) -> {ok, [Row]} | {error, Error}
select(Sql, Module) ->
    erlydb_drv:select(Sql, Module).


%% @doc Generate code for the given Models based on database metadata.
%%   This function throws an exception unless there is an open connection to
%%   the database.
%%
%% @spec code_gen(Models::[Module::atom()]) -> ok
%% @throws {error, Error}
code_gen(Modules) ->
    TablesDict = erlydb_drv:get_metadata(),
    lists:foreach(
      fun(Module) ->
	      case process_module(Module, TablesDict) of
		  ok ->
		      ok;
		  Err ->
		      throw(Err)
	      end
      end, Modules).

%% Generate the code for interacting with the database table that
%% corresponds to the Module's name.
process_module(Module, TablesDict) ->
    case smerl:for_module(Module) of
	{ok, C1} ->
	    case dict:find(atom_to_list(Module), TablesDict) of
		{ok, Fields} ->
		    MetaMod = make_module(C1, Fields),
		    ok = smerl:compile(MetaMod);
		error ->
		    {error, {no_such_table, Module}}
	    end;
	Err ->
	    Err
    end.

%% Make the abstract forms for the module.
make_module(MetaMod, Fields) ->
    %% extend the base module, erlydb_base
    M1 = smerl:extend(erlydb_base, MetaMod),

    Module = smerl:get_module(MetaMod),
    {ok, M2} = smerl:add_func(M1,
		 make_new_func(
		   Module, Fields)),
    
    {M3, _Count} = lists:foldl(
		     fun(Field, {C2, Count}) ->
			     Idx = Count,
			     {make_field_forms(Field, Idx, C2), Count+1}
		     end, {M2, 3}, Fields),

    %% inject the fields list into the fields/1 function
    {ok, M4} = smerl:curry_replace(M3, fields, 1, [Fields]),

    M5 = make_rel_funcs(M4),

    %% embed the Module name in place of all 'Module' parameters
    %% in the base forms
    M6 = smerl:embed_all(M5, [{'Module', smerl:get_module(MetaMod)}]),

    M6.

%% Create the abstract form for the given Module's 'new' function.
%%
%% For related records, the 'new' function accepts as a parameter
%% either a tuple representing the related record, or the record's
%% id directly.
%%
%% Example:
%% {ok, Erlang} = language:find_id(1),
%% project:new("Yaws", Lang) == project:new("Yaws", language:id(Lang))
%%
make_new_func(Module, [_IdField | Fields]) ->
    L = 1,
    Params =
	lists:map(
	  fun(Field) ->
		  {_Res, Field1} = strip_id_chars(Field),
    		  {var,L,Field1}
	  end, Fields),
    
    Values  =
	lists:map(
	  fun(Field) ->
		  case strip_id_chars(Field) of
		      {true, Field1} ->
			  make_new_func_if_expr(Field1);
		      {false, _Field1} ->
			  {var, L, Field}
		  end
	  end, Fields),
    
    Func =
	{function,L,new,length(Fields),
	 [{clause,L,Params,[],
	   [{tuple,L,
	     [{atom,L,true},{atom,L,Module},{atom,L,undefined}|Values]}
	   ]}
	 ]},
    Func.			

%% Return the following expression:
%%
%% if is_tuple(Param) -> 'Param':id(Param); true -> Param end
%%
%% This allows you to pass into the constructor either a related record
%% or the related record's id directly. If you pass in a related,
%% record, its id is automatically substituted as the parameter's
%% value.
make_new_func_if_expr(Param) ->
    L = 1,
    {'if',L,
     [{clause,L,
       [],
       [[{call,L,{atom,L,is_tuple},[{var,L,Param}]}]],
       [{call,L,
	 {remote,L,{atom,L,Param},{atom,L,id}},
	 [{var,L,Param}]}]},
      {clause,L,[],[[{atom,L,true}]],[{var,L,Param}]}]}.

%% If Field is an atom such as 'person_id', return the atom 'person'.
%% Otherwise, return the original atom.
strip_id_chars(Field) ->
    FieldName = atom_to_list(Field),
    FieldLen = length(FieldName),
    LastThreeChars =
	string:substr(FieldName,
		      FieldLen - 2, 3),
    if
	LastThreeChars == "_id" ->
	    {true, list_to_atom(string:substr(FieldName, 1, FieldLen - 3))};
	true ->
	    {false, Field}
    end.
	    
%% Add field-specific metafunctions to the MetaMod object.
make_field_forms(Field, Idx, MetaMod) ->
    {ok, C1} = smerl:curry_add(MetaMod, ?MODULE, get, 2, Idx, Field),
    {ok, C2} = smerl:curry_add(C1, ?MODULE, set, 3, Idx, Field),
    C2.

%% Generate the forms for functions that deal with related
%% records.
make_rel_funcs(MetaMod) ->
    Module = smerl:get_module(MetaMod),
    case catch Module:relations() of
	{'EXIT', _} ->
	    MetaMod;
	Relations ->
	    lists:foldl(
	      fun({RelType, Modules}, MetaMod1) ->
		      make_rel_forms(RelType, Modules, MetaMod1)
	      end, MetaMod, Relations)
    end.

make_rel_forms(RelType, Modules, MetaMod) ->
    Fun =
	case RelType of
	    many_to_one ->
		fun make_many_to_one_forms/2;
	    one_to_many ->
		fun make_one_to_many_forms/2;
	    many_to_many ->
		fun make_many_to_many_forms/2
	end,
    lists:foldl(Fun, MetaMod, Modules).    

make_many_to_one_forms(OtherModule, MetaMod) ->
    M1 = curry_add(
	   MetaMod, get_related_one_to_many, OtherModule,
	   OtherModule),
    {ok, M2} = 
	smerl:curry_add(M1, ?MODULE, meta_func, 4,
			[smerl:get_module(MetaMod), set_related_one_to_many],
			OtherModule),
    M2.

make_one_to_many_forms(OtherModule, MetaMod) ->
    make_some_to_many_forms(
      OtherModule, MetaMod, get_related_many_to_one).

make_some_to_many_forms(OtherModule, MetaMod, BaseFuncName) ->
    make_some_to_many_forms(OtherModule, MetaMod, BaseFuncName, []).

make_some_to_many_forms(OtherModule, MetaMod, BaseFuncName,
			ExtraCurryParams) ->
    Module = smerl:get_module(MetaMod),
    {ok, M1} =
	smerl:curry_add(
	  MetaMod, ?MODULE, meta_func, 4 + length(ExtraCurryParams),
	  [Module, BaseFuncName,OtherModule | ExtraCurryParams],
	  pluralize(OtherModule)),
    {ok,M2} =
	smerl:curry_add
	  (M1, ?MODULE, meta_func, 5 + length(ExtraCurryParams),
	   [Module,BaseFuncName,OtherModule | ExtraCurryParams],
	   pluralize(OtherModule, "_where")),
    {ok,M3} =
	smerl:curry_add(
	  M2, ?MODULE, meta_func, 5 + length(ExtraCurryParams),
	  [Module,list_to_atom(atom_to_list(BaseFuncName) ++ "_with"),
	   OtherModule | ExtraCurryParams],
	  pluralize(OtherModule, "_with")),
    {ok,M4} =
	smerl:curry_add(
	  M3, ?MODULE, meta_func, 6 + length(ExtraCurryParams),
	  [Module,BaseFuncName,OtherModule | ExtraCurryParams],
	  pluralize(OtherModule)),
    M4.

make_many_to_many_forms(OtherModule, MetaMod) ->
    ModuleName = smerl:get_module(MetaMod),
    
    %% The name of the join table is currently assumed
    %% to be the alphabetical ordering of the two tables,
    %% separated by an underscore.
    %% Good example: person_project
    %% Bad example: project_person
    [Module1, Module2] = 
	lists:sort([ModuleName, OtherModule]),
    JoinTableName = list_to_atom(
		      atom_to_list(Module1) ++
		      "_" ++ atom_to_list(Module2)),

    M1 = make_some_to_many_forms(
	   OtherModule, MetaMod, get_related_many_to_many,
	   [JoinTableName]),

    AddFuncName =
	list_to_atom("add_" ++ atom_to_list(OtherModule)),
    {ok, M2} =
	smerl:curry_add(
	  M1, ?MODULE, meta_func, 5,
	  [ModuleName, add_related_many_to_many, JoinTableName],
	  AddFuncName),
		    
    RemoveFuncName = 
	list_to_atom("remove_" ++ atom_to_list(OtherModule)),
    {ok, M3} =
	smerl:curry_add(
	  M2, ?MODULE, meta_func, 5,
	  [ModuleName, remove_related_many_to_many, JoinTableName],
	  RemoveFuncName),
    M3.


curry_add(MetaMod, Func, Param1, NewFuncName) ->
    {ok, M1} =
	smerl:curry_add(MetaMod, erlydb, meta_func, 4,
			[smerl:get_module(MetaMod), Func, Param1],
			NewFuncName),
    M1.

meta_func(Module, Func, Param1) ->
    Module:Func(Param1).
meta_func(Module, Func, Param1, Param2) ->
    Module:Func(Param1, Param2).
meta_func(Module, Func, Param1, Param2, Param3) ->
    Module:Func(Param1, Param2, Param3).
meta_func(Module, Func, Param1, Param2, Param3, Param4) ->
    Module:Func(Param1, Param2, Param3, Param4).
meta_func(Module, Func, Param1, Param2, Param3, Param4, Param5) ->
    Module:Func(Param1, Param2, Param3, Param4, Param5).

%% TODO There are probably a bunch of additional cases, but this is good
%% enough for now :)
pluralize(Module) ->
    pluralize(Module, undefined).

pluralize(Module, Postfix) ->
    Str = atom_to_list(Module),
    [LastChar, CharBeforeLast|Rest] = Rev = lists:reverse(Str),
    Suffix = [CharBeforeLast,LastChar],
    Irregulars =
	[{man, men},{foot,feet},{child,children},{person,people},
	 {tooth,teeth},{mouse,mice},{sheep,sheep},{deer,deer},{fish,fish}],
    PluralForm =
	case lists:keysearch(Module,1,Irregulars) of
	    {value, {_, Plural}} ->
		atom_to_list(Plural);
	    _ ->
		if Suffix == "fe" ->
			lists:reverse([$s,$e,$v | Rest]);
		   LastChar == $f ->
			lists:reverse([$s,$e,$v,CharBeforeLast | Rest]);
		   
		   %% These rules only work in some special cases, so we'll
		   %% comment them out for now and possibly deal with them
		   %% later
		   %% Suffix == "is" ->
		   %%	lists:reverse([$s,$e|Rest]);
		   %% Suffix == "on" ->
		   %%   lists:reverse([$a | Rest]);
		   %% Suffix == "us" ->
		   %%   lists:reverse([$i | Rest]);

		   true ->
			Cond1 = LastChar == $y andalso
			    lists:member(CharBeforeLast,
					 "bcdfghjklmnpqrtvwxyz"),
			if
			    Cond1 ->
				lists:reverse([$s,$e,$i,CharBeforeLast|Rest]);
			    true ->
				Cond2 = case Rev of
					    [$s|_] -> true;
					    [$h,$c|_] -> true;
					    [$h,$s|_] -> true;
					    [$x|_] -> true;
					    [$o|_] -> true;
					    _ -> false
					end,
				if Cond2 ->
					Str ++ "es";
				   true ->
					Str ++ "s"
				end
			end
		end
	end,
    Result =
	case Postfix of
	    undefined ->
		PluralForm;
	    _ ->
		PluralForm ++ Postfix
	end,
    list_to_atom(Result).
		
%% A metafunction for generating getters, e.g. person:name(Person).
get(Idx, Tuple) ->
    element(Idx, Tuple).

%% A metafunction for generating setters, e.g. person:name(Person, "Bob")
set(Idx, Tuple, Val) ->
    setelement(Idx, Tuple, Val).
